home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / telecom / 16 / pascal / mountain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-13  |  8.4 KB  |  277 lines
  1. PROGRAM mountain2;
  2.  
  3. (* This program is supposed to draw "Mandelbrot" shapes that resemble *)
  4. (* mountains.     This is done by starting with a triangle figure and *)
  5. (* successively subdividing (randomly spaced) the sides. These points *)
  6. (* are then joined to form four smaller triangles within the original *)
  7. (* one.  The process is repeated for each of these four triangles and *)
  8. (* onto the next step of transformation.....                          *)
  9.  
  10. (*      Original Pascal program written by: John O'Neill              *)
  11. (*     Translated to C for the Atari ST by: Bob Ritter (Nov. 1985)    *)
  12. (*     Translated back to Pascal(!) by Mark Rose -- 24 April, 1986    *)
  13. (*       (sorry, but the C version didn't have many comments and I    *)
  14. (*        didn't have time to explain everything!)                    *)
  15.  
  16.   CONST
  17.     (*$I gemconst.pas*)
  18.  
  19.     num_steps = 7;      (* That's all we can generate with our array size! *)
  20.     two_pi = 6.2631853;
  21.  
  22.   TYPE
  23.     (*$I gemtype.pas*)
  24.  
  25.     tree_rec = RECORD
  26.                  locx, locy, left, right: integer;
  27.                END;
  28.  
  29.   VAR
  30.     mtree: ARRAY[ 0..3999 ] OF tree_rec;
  31.     step: integer;
  32.     go_left: boolean;
  33.     i, c, num_trees: integer;
  34.     s, line_str: str255;
  35.     scale: real; (* Was 0.22 in original version *)
  36.     junk: integer;
  37.  
  38.   (*$I gemsubs.pas*)
  39.  
  40.   FUNCTION random: real;
  41.  
  42.     CONST
  43.       max_random = 16777215;    (* 2^24 - 1 *)
  44.  
  45.     FUNCTION irandom: long_integer;
  46.       XBIOS( 17 );
  47.  
  48.     BEGIN
  49.       random := irandom / max_random;
  50.     END;
  51.  
  52.  
  53.  
  54.   PROCEDURE str( n: integer; VAR s: str255 );
  55.  
  56.     VAR
  57.       digit,            (* Holds each digit value of 'n' as it is created *)
  58.       divisor,          (* Division by this is used to find each digit *)
  59.       i: integer;       (* Index in string at which to put next character *)
  60.       leading: boolean; (* True, if the next digit will be the leading digit *)
  61.  
  62.     BEGIN (* str - main routine *)
  63.       s := '     0';
  64.       i := 0;           (* Start at the beginning of the string *)
  65.       IF n < 0 THEN     (* If the number is negative, add a minus sign *)
  66.         BEGIN
  67.           s[1] := '-';
  68.           n := -n;
  69.         END;
  70.       divisor := 10000;
  71.       leading := true;
  72.       FOR i := 2 TO 6 DO
  73.         BEGIN
  74.           digit := n DIV divisor;
  75.           IF (digit <> 0) OR NOT( leading ) THEN
  76.             BEGIN
  77.               s[i] := chr(digit + ord('0'));
  78.               leading := false;
  79.             END;
  80.           n := n MOD divisor;
  81.           divisor := divisor DIV 10;
  82.         END;
  83.     END;
  84.  
  85.  
  86.  
  87.   (* wait_button - Wait for the user to press the mouse button.  Return with the
  88.       X and Y position where it was pressed. *)
  89.  
  90.   PROCEDURE wait_button( VAR x, y: integer );
  91.  
  92.     VAR
  93.       junk: integer;
  94.       msg: Message_Buffer;
  95.  
  96.     BEGIN
  97.       junk := Get_Event( E_Button, 1, 1, 1, 0,
  98.                         false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  99.                         msg, junk, junk, junk, x, y, junk );
  100.       junk := Get_Event( E_Button, 1, 0, 1, 0,
  101.                         false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  102.                         msg, junk, junk, junk, junk, junk, junk );
  103.     END;
  104.  
  105.  
  106.  
  107.   (* setup - Get the scale and first three points from user.  These form the
  108.       first triangle in the deformation. *)
  109.  
  110.   PROCEDURE setup;
  111.  
  112.     VAR
  113.       junk, mx1, my1, mx2, my2, mx3, my3: integer;
  114.  
  115.     BEGIN
  116.       (* Set the system up to do GEM calls*)
  117.       junk := Init_Gem;
  118.  
  119.       Hide_Mouse;
  120.       Clear_Screen;
  121.       Show_Mouse;
  122.       Set_Mouse( M_Point_Hand );
  123.       Draw_String( 16, 15, 'Choose desired scale:' );
  124.       Draw_String( 16, 50, '0' );
  125.       Draw_String( 215, 50, '1' );
  126.       Line( 23, 52, 215, 52 );
  127.       wait_button( mx1, my1 );
  128.       IF mx1 < 16 THEN mx1 := 16;
  129.       IF mx1 > 215 THEN mx1 := 215;
  130.       scale := (mx1-16) / 200;
  131.  
  132.       Hide_Mouse;
  133.       Clear_Screen;
  134.       Show_Mouse;
  135.       Set_Mouse( M_Thin_Cross );
  136.  
  137.       Draw_String( 16, 15, 'Click the mouse on the 3 starting co-ordinates.' );
  138.       Wait_Button( mx1, my1 );
  139.       Wait_Button( mx2, my2 );
  140.       Hide_Mouse;
  141.       Line( mx1, my1, mx2, my2 );
  142.       Show_Mouse;
  143.       Wait_Button( mx3, my3 );
  144.       Hide_Mouse;
  145.       Line( mx2, my2, mx3, my3 );
  146.       Line( mx3, my3, mx1, my1 );
  147.       Show_Mouse;
  148.       Set_Mouse( M_Arrow );
  149.  
  150.       num_trees := 2;  (* well, really it's one more... *)
  151.       mtree[0].left  := 1;
  152.       mtree[0].right := 2;
  153.       mtree[1].left  := 0;
  154.       mtree[1].right := 0;
  155.       mtree[2].left  := 0;
  156.       mtree[2].right := 0;
  157.       mtree[0].locx := mx1;
  158.       mtree[0].locy := my1;
  159.       mtree[1].locx := mx2;
  160.       mtree[1].locy := my2;
  161.       mtree[2].locx := mx3;
  162.       mtree[2].locy := my3;
  163.     END;
  164.  
  165.  
  166.  
  167.   (* midpoint - Deform the midpoint of a line segment, and put the new point
  168.       into the position 'mp' in the tree. *)
  169.  
  170.   PROCEDURE midpoint( mp, x1, y1, x2, y2: integer );
  171.  
  172.     VAR
  173.       dx, dy, length, radius, angle: real;
  174.  
  175.     BEGIN
  176.       dx := x2 - x1;
  177.       dy := y2 - y1;
  178.       length := sqrt( dx*dx + dy*dy );
  179.       radius := length * scale * random;
  180.       angle := two_pi * random;
  181.       mtree[mp].locx := round( (x1+x2)/2 );
  182.       (* This code is deleted: + cos(angle) * radius ); -- We now only deform
  183.         the midpoint in the y axis.  This makes the resulting mountain look
  184.         better -- MER *)
  185.       mtree[mp].locy := round( (y1+y2)/2 + sin(angle) * radius );
  186.     END;
  187.  
  188.  
  189.  
  190.   (* transform - Compute the next iteration of the tree of mountain vertices.
  191.       Each current triangle is subdivided into 4 new triangles, slightly
  192.       deformed. *)
  193.  
  194.   PROCEDURE transform( node: integer );
  195.  
  196.     BEGIN
  197.       IF go_left AND (mtree[mtree[node].left].left <> 0) THEN
  198.          transform( mtree[node].left );
  199.       go_left := false;
  200.       IF mtree[mtree[node].right].right <> 0 THEN
  201.         transform( mtree[node].right );
  202.       str( c, s );
  203.       Draw_String( 32, 32, s );
  204.       c := c - 1;
  205.       midpoint( num_trees+1, mtree[node].locx, mtree[node].locy,
  206.                 mtree[mtree[node].left].locx, mtree[mtree[node].left].locy );
  207.       midpoint( num_trees+2,
  208.                 mtree[mtree[node].left].locx, mtree[mtree[node].left].locy,
  209.                 mtree[mtree[node].right].locx, mtree[mtree[node].right].locy );
  210.       midpoint(num_trees+3, mtree[node].locx, mtree[node].locy,
  211.                 mtree[mtree[node].right].locx, mtree[mtree[node].right].locy );
  212.       mtree[num_trees+1].left  := mtree[node].left;
  213.       mtree[num_trees+1].right := num_trees + 2;
  214.       mtree[num_trees+3].left  := num_trees + 2;
  215.       mtree[num_trees+3].right := mtree[node].right;
  216.       mtree[num_trees+2].left  := mtree[mtree[node].left].right;
  217.       mtree[num_trees+2].right := mtree[mtree[node].right].left;
  218.       mtree[node].left  := num_trees + 1;
  219.       mtree[node].right := num_trees + 3;
  220.       num_trees := num_trees + 3;
  221.     END;
  222.  
  223.  
  224.  
  225.   (* display - Show the current iteration of the mountain. *)
  226.  
  227.   PROCEDURE display( node: integer );
  228.  
  229.     BEGIN
  230.       IF go_left AND (mtree[mtree[node].left].left <> 0) THEN
  231.         display( mtree[node].left );
  232.       go_left := false;
  233.       IF mtree[mtree[node].right].right <> 0 THEN
  234.         display( mtree[node].right );
  235.       Line( mtree[node].locx, mtree[node].locy,
  236.                 mtree[mtree[node].left].locx, mtree[mtree[node].left].locy );
  237.       Line( mtree[mtree[node].left].locx, mtree[mtree[node].left].locy,
  238.                 mtree[mtree[node].right].locx, mtree[mtree[node].right].locy );
  239.       Line( mtree[mtree[node].right].locx, mtree[mtree[node].right].locy,
  240.                 mtree[node].locx, mtree[node].locy );
  241.     END;
  242.  
  243.  
  244.  
  245.   (* main routine! *)
  246.  
  247.   BEGIN
  248.     line_str := 'Step:        Number of points:      ';
  249.     setup;
  250.     go_left := true;
  251.     Hide_Mouse;
  252.     display( 0 );
  253.     Show_Mouse;
  254.     wait_button( junk, junk );
  255.     FOR step := 2 TO num_steps DO
  256.       BEGIN
  257.         go_left := true;
  258.         c := num_trees;
  259.         transform( 0 );
  260.         go_left := true;
  261.         Hide_Mouse;
  262.         Clear_Screen;
  263.         Show_Mouse;
  264.         str( step, s );
  265.         FOR i := 1 TO length(s) DO
  266.           line_str[5+i] := s[i];
  267.         str(num_trees+1, s );
  268.         FOR i := 1 TO length(s) DO
  269.           line_str[30+i] := s[i];
  270.         Hide_Mouse;
  271.         Draw_String( 75, 15, line_str );
  272.         display( 0 );
  273.         Show_Mouse;
  274.         wait_button( junk, junk );
  275.       END;
  276.   END.
  277. ooooooooooooooooo